home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / proc.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-23  |  35.1 KB  |  1,386 lines
  1. IMPLEMENTATION MODULE proc;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
  14. (* --------------------------------------------------------------------------*)
  15. (* 16-Dez-93, Holger Kleinschmidt                                            *)
  16. (*****************************************************************************)
  17.  
  18. VAL_INTRINSIC
  19. CAST_IMPORT
  20. INLINE_CODE_IMPORT
  21. PTR_ARITH_IMPORT
  22.  
  23. FROM SYSTEM IMPORT
  24. (* TYPE *) ADDRESS,
  25. (* PROC *) ADR;
  26.  
  27. FROM PORTAB IMPORT
  28. (* CONST*) NULL,
  29. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, ANYLONG,
  30.            WORDSET;
  31.  
  32. FROM MEMBLK IMPORT
  33. (* PROC *) memalloc, memdealloc;
  34.  
  35. FROM OSCALLS IMPORT
  36. (* PROC *) Pgetpid, Pgetppid, Pgetuid, Pgetgid, Pgeteuid, Pgetegid, Psetuid,
  37.            Psetgid, Pgetpgrp, Psetpgrp, Pfork, Pwait3, Pwaitpid, Malloc, Mfree,
  38.            Mshrink, Pexec, Pterm, Prusage, Fclose;
  39.  
  40. FROM ctype IMPORT
  41. (* PROC *) todigit;
  42.  
  43. FROM cstr IMPORT
  44. (* PROC *) strlen;
  45.  
  46. FROM pSTRING IMPORT
  47. (* PROC *) COPY, ASSIGN, TOKEN, SLEN, APPEND, APPENDCHR, RPOSCHR, RPOSCHRSET;
  48.  
  49. FROM cmdline IMPORT
  50. (* VAR  *) environ,
  51. (* PROC *) GetEnvVar;
  52.  
  53. FROM types IMPORT
  54. (* CONST*) EOS, PATHMAX, SUFFIXSEP, DDIRSEP, XDIRSEP,
  55. (* TYPE *) PathName, sizeT, uidT, gidT, pidT, clockT, StrArray, StrPtr,
  56.            StrRange, ArrayRange;
  57.  
  58. IMPORT e;
  59.  
  60. FROM DosSupport IMPORT
  61. (* CONST*) EXECSUFFIX, DINCR, MinHandle, MaxHandle,
  62. (* TYPE *) FileType, HandleRange,
  63. (* VAR  *) FD,
  64. (* PROC *) UnixToDos;
  65.  
  66. FROM DosSystem IMPORT
  67. (* TYPE *) CmdLine, BasePtr, BasePage,
  68. (* VAR  *) BASEP,
  69. (* PROC *) SysClock, DosPid, MiNTVersion;
  70.  
  71. FROM file IMPORT
  72. (* CONST*) sIFMT, sIFREG,
  73. (* TYPE *) StatRec, modeT,
  74. (* PROC *) stat, close;
  75.  
  76. (*==========================================================================*)
  77.  
  78. CONST
  79.   EOKL = LIC(0);
  80.  
  81. CONST
  82.   BPSIZE = 256; (* Groesse einer Basepage *)
  83.  
  84. (* Lokale Umdefinition der Basepage fuer "tfork()" *)
  85. TYPE
  86.   BPtr  = POINTER TO BPage;
  87.   BPage = RECORD
  88.     lowtpa : ADDRESS;
  89.     hitpa  : ADDRESS;
  90.     tbase  : PROC;
  91.     tlen   : UNSIGNEDLONG;
  92.     dbase  : ADDRESS;
  93.     dlen   : UNSIGNEDLONG;
  94.     bbase  : ADDRESS;
  95.     blen   : UNSIGNEDLONG;
  96.     dta    : ADDRESS;
  97.     parent : BPtr;
  98.     res1   : UNSIGNEDLONG;
  99.     env    : ADDRESS;
  100.     res2   : ARRAY [0..49] OF ANYLONG;
  101.     (* Die restlichen zwei Langworte der Kommandozeile
  102.        (die leer ist) dienen als Zwischenspeicher fuer
  103.        die Uebergabe des ``Thread'' und dessen Parameter.
  104.      *)
  105.     tProc  : ThreadProc;
  106.     tArg   : ANYLONG;
  107.   END;
  108.  
  109. TYPE
  110.   WaitCode =  RECORD
  111.     CASE TAG_COLON BOOLEAN OF
  112.       FALSE: long : SIGNEDLONG;
  113.      |TRUE : pid  : UNSIGNEDWORD;
  114.              term : SIGNEDWORD;
  115.     END;
  116.   END;
  117.  
  118. VAR
  119.   MiNT      : BOOLEAN;
  120.   Stacksize : CARDINAL;
  121.   CHILDTIME : UNSIGNEDLONG;
  122.   WAITVAL   : WaitCode;
  123.   errnoADR  : ADDRESS;
  124.   tforkADR  : ADDRESS;
  125.   mintADR   : ADDRESS;
  126.   saveADR   : ADDRESS;
  127. #if (defined LPRM2) || (defined SPCM2)
  128.   regsave   : ARRAY [0..3] OF ADDRESS;
  129. #elif (defined TDIM2)
  130.   regsave   : ARRAY [0..1] OF ADDRESS;
  131. #elif (defined HM2)
  132.   regsave   : ARRAY [0..12] OF ADDRESS;
  133. #elif (defined MM2)
  134.   regsave   : ARRAY [0..10] OF ADDRESS;
  135. #endif
  136.  
  137. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  138.  
  139. PROCEDURE getpid ( ): pidT;
  140. BEGIN
  141.  IF MiNT THEN
  142.    RETURN(Pgetpid());
  143.  ELSE
  144.    RETURN(DosPid(BASEP));
  145.  END;
  146. END getpid;
  147.  
  148. (*---------------------------------------------------------------------------*)
  149.  
  150. PROCEDURE getppid ( ): pidT;
  151. BEGIN
  152.  IF MiNT THEN
  153.    RETURN(Pgetppid());
  154.  ELSE
  155.    RETURN(DosPid(BASEP^.pParent));
  156.  END;
  157. END getppid;
  158.  
  159. (*---------------------------------------------------------------------------*)
  160.  
  161. PROCEDURE getuid ( ): uidT;
  162. BEGIN
  163.  IF MiNT THEN
  164.    RETURN(Pgetuid());
  165.  ELSE
  166.    RETURN(0);
  167.  END;
  168. END getuid;
  169.  
  170. (*---------------------------------------------------------------------------*)
  171.  
  172. PROCEDURE getgid ( ): gidT;
  173. BEGIN
  174.  IF MiNT THEN
  175.    RETURN(Pgetgid());
  176.  ELSE
  177.    RETURN(0);
  178.  END;
  179. END getgid;
  180.  
  181. (*---------------------------------------------------------------------------*)
  182.  
  183. PROCEDURE geteuid ( ): uidT;
  184. BEGIN
  185.  IF MiNT THEN
  186.    RETURN(Pgeteuid());
  187.  ELSE
  188.    RETURN(0);
  189.  END;
  190. END geteuid;
  191.  
  192. (*---------------------------------------------------------------------------*)
  193.  
  194. PROCEDURE getegid ( ): gidT;
  195. BEGIN
  196.  IF MiNT THEN
  197.    RETURN(Pgetegid());
  198.  ELSE
  199.    RETURN(0);
  200.  END;
  201. END getegid;
  202.  
  203. (*---------------------------------------------------------------------------*)
  204.  
  205. PROCEDURE setuid ((* EIN/ -- *) uid : uidT ): INTEGER;
  206.  
  207. VAR res : INTEGER;
  208.  
  209. BEGIN
  210.  IF MiNT THEN
  211.    IF Psetuid(uid, res) THEN
  212.      RETURN(0);
  213.    ELSE
  214.      IF res = e.eACCDN THEN
  215.        e.errno := e.EPERM;
  216.      ELSE
  217.        e.errno := res;
  218.      END;
  219.      RETURN(-1);
  220.    END;
  221.  ELSE
  222.    IF uid = 0 THEN
  223.      RETURN(0);
  224.    ELSE
  225.      e.errno := e.EINVAL;
  226.      RETURN(-1);
  227.    END;
  228.  END;
  229. END setuid;
  230.  
  231. (*---------------------------------------------------------------------------*)
  232.  
  233. PROCEDURE setgid ((* EIN/ -- *) gid : gidT ): INTEGER;
  234.  
  235. VAR res : INTEGER;
  236.  
  237. BEGIN
  238.  IF MiNT THEN
  239.    IF Psetgid(gid, res) THEN
  240.      RETURN(0);
  241.    ELSE
  242.      IF res = e.eACCDN THEN
  243.        e.errno := e.EPERM;
  244.      ELSE
  245.        e.errno := res;
  246.      END;
  247.      RETURN(-1);
  248.    END;
  249.  ELSE
  250.    IF gid = 0 THEN
  251.      RETURN(0);
  252.    ELSE
  253.      e.errno := e.EINVAL;
  254.      RETURN(-1);
  255.    END;
  256.  END;
  257. END setgid;
  258.  
  259. (*---------------------------------------------------------------------------*)
  260.  
  261. PROCEDURE getpgrp ( ): pidT;
  262. BEGIN
  263.  IF MiNT THEN
  264.    RETURN(Pgetpgrp());
  265.  ELSE
  266.    RETURN(DosPid(BASEP));
  267.  END;
  268. END getpgrp;
  269.  
  270. (*---------------------------------------------------------------------------*)
  271.  
  272. PROCEDURE setpgid ((* EIN/ -- *) pid  : pidT;
  273.                    (* EIN/ -- *) pgid : pidT ): INTEGER;
  274.  
  275. VAR PID : INTEGER;
  276.  
  277. BEGIN
  278.  IF MiNT THEN
  279.    IF (pid < 0) OR (pgid < 0) THEN
  280.      e.errno := e.EINVAL;
  281.      RETURN(-1);
  282.    ELSIF pgid = 0 THEN
  283.      pgid := Pgetpid();
  284.    END;
  285.    IF Psetpgrp(pid, pgid, pgid) THEN
  286.      RETURN(0);
  287.    ELSE
  288.      IF pgid = e.eACCDN THEN
  289.        e.errno := e.ESRCH;
  290.      ELSE
  291.        e.errno := pgid;
  292.      END;
  293.      RETURN(-1);
  294.    END;
  295.  ELSE
  296.    PID := DosPid(BASEP);
  297.    IF    ((pid  = 0) OR (pid  = PID))
  298.      AND ((pgid = 0) OR (pgid = PID))
  299.    THEN
  300.      RETURN(0);
  301.    ELSE
  302.      e.errno := e.EINVAL;
  303.      RETURN(-1);
  304.    END;
  305.  END;
  306. END setpgid;
  307.  
  308. (*--------------------------------------------------------------------------*)
  309.  
  310. PROCEDURE setsid ( ): pidT;
  311.  
  312. VAR res : INTEGER;
  313.  
  314. BEGIN
  315.  IF MiNT THEN
  316.    IF Pgetpgrp() = Pgetpid() THEN
  317.      (* Prozess ist bereits ``process group leader'', darf
  318.       * kein "setsid()" ausfuehren.
  319.       *)
  320.      e.errno := e.EPERM;
  321.      RETURN(-1);
  322.    END;
  323.  
  324.    (* Neue Prozessgruppe hat die Kennung des aufrufenden Prozesses. *)
  325.    IF Psetpgrp(0, 0, res) THEN
  326.      RETURN(res);
  327.    ELSE
  328.      IF res = e.eACCDN THEN
  329.        e.errno := e.ESRCH;
  330.      ELSE
  331.        e.errno := res;
  332.      END;
  333.      RETURN(-1);
  334.    END;
  335.  ELSE
  336.    e.errno := e.EPERM;
  337.    RETURN(-1);
  338.  END;
  339. END setsid;
  340.  
  341. (*--------------------------------------------------------------------------*)
  342.  
  343. PROCEDURE fork ( ): pidT;
  344.  
  345. VAR res : INTEGER;
  346.  
  347. BEGIN
  348.  IF MiNT THEN
  349.    res := Pfork();
  350.    IF res >= 0 THEN
  351.      RETURN(res);
  352.    ELSE
  353.      e.errno := res;
  354.      RETURN(-1);
  355.    END;
  356.  ELSE
  357.    e.errno := e.ENOSYS;
  358.    RETURN(-1);
  359.  END;
  360. END fork;
  361.  
  362. (*---------------------------------------------------------------------------*)
  363.  
  364. PROCEDURE MakeWaitVal ((* EIN/ -- *) retCode : SIGNEDWORD ): SIGNEDWORD;
  365.  
  366. CONST SIGINT = 2;
  367.  
  368. VAR __REG__ exit : UNSIGNEDWORD;
  369.     __REG__ sig  : UNSIGNEDWORD;
  370.     __REG__ ret  : WORDSET;
  371.  
  372. BEGIN
  373.  IF retCode = -32 THEN
  374.    (* Programm wurde durch 'Ctrl-C' abgebrochen *)
  375.    exit := 0;
  376.    sig  := SIGINT;
  377.  ELSE
  378.    ret  := CAST(WORDSET,retCode);
  379. #if reverse_set
  380.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{8..15});
  381.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{1..7}) DIV 256);
  382. #else
  383.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{0..7});
  384.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{8..14}) DIV 256);
  385. #endif
  386.  END;
  387.  IF (sig <> 0) AND (exit <> 0) AND (exit <> 127) THEN
  388.    (* normaler Returncode, kein Signal *)
  389.    sig := 0;
  390.  END;
  391.  IF (exit = 127) AND (sig <> 0) THEN
  392.    (* Prozess gestoppt *)
  393.    RETURN(retCode); (* ist schon entsprechend kodiert *)
  394.  ELSE
  395.    (* Prozess terminiert, evtl. durch Signal *)
  396.    RETURN(VAL(SIGNEDWORD,exit * 256 + sig));
  397.  END;
  398. END MakeWaitVal;
  399.  
  400. (*---------------------------------------------------------------------------*)
  401.  
  402. PROCEDURE SetStacksize ((* EIN/ -- *) stacksize : CARDINAL);
  403. BEGIN
  404.  IF stacksize < MINSTACKSIZE THEN
  405.    Stacksize := BPSIZE + MINSTACKSIZE;
  406.  ELSE
  407.    Stacksize := BPSIZE + stacksize;
  408.  END;
  409. END SetStacksize;
  410.  
  411. (*---------------------------------------------------------------------------*)
  412.  
  413. #if (defined HM2)
  414. (*$E+ lokale Prozedur als Parameter *)
  415. #endif
  416. PROCEDURE startup;
  417. (* Diese Prozedur ist die erste Anweisung, die nach dem "Pexec()" in
  418.  * "tfork()" ausgefuehrt wird. An ihrer Stelle staende normalerweise
  419.  * die Initialisierungsroutine eines gestarteten Programms. Aus diesem
  420.  * Grund hat auch lediglich Register A7 einen definierten Wert! A7 zeigt
  421.  * auf das Ende der TPA, und ueber 4(A7) ist die Adresse der eigenen Basepage
  422.  * erreichbar.
  423.  * Falls der M2-Compiler beim Beginn der Prozedur erwartet, dass
  424.  * bestimmte Register definierte Werte haben (z.B. Megamax: A3 ist der
  425.  * Parameterstack!), muessen diese Register entsprechend gesetzt werden,
  426.  * bevor auf sie zugegriffen wird.
  427.  *)
  428. VAR b : BPtr;
  429.  
  430. BEGIN
  431. #if (defined MM2)
  432.   CODE(202DH,0008H); (* move.l 8(A5),D0 *)
  433. #elif (defined HM2) || (defined TDIM2)
  434.   CODE(202EH,0008H); (* move.l 8(A6),D0 *)
  435. #elif (defined LPRM2) || (defined SPCM2)
  436.   INLINE(202EH,000CH); (* move.l 12(A6),D0 *)
  437. #endif
  438.   GETREGADR(0, b);
  439. #ifdef MM2
  440.   (* A3 auf Stackanfang setzen, direkt hinter die Basepage *)
  441.   SETREG(11, ADDADR(b, BPSIZE));
  442. #endif
  443.  
  444.   WITH b^ DO
  445.     Pterm(tProc(tArg));
  446.   END;
  447. END startup;
  448. #if (defined HM2)
  449. (*$E=*)
  450. #endif
  451.  
  452. (*---------------------------------------------------------------------------*)
  453.  
  454. PROCEDURE tfork ((* EIN/ -- *) func : ThreadProc;
  455.                  (* EIN/ -- *) arg  : ANYLONG    ): INTEGER;
  456.  
  457. VAR b     : BPtr;
  458.     pid   : SIGNEDLONG;
  459.     ret   : SIGNEDLONG;
  460.     err   : INTEGER;
  461.     ch    : CHAR;
  462.     done  : BOOLEAN;
  463.     void  : BOOLEAN;
  464.     base  : BasePtr;
  465.     start : UNSIGNEDLONG;
  466.  
  467. BEGIN
  468.   ch := 0C;
  469.   IF Pexec(5, NULL, ADR(ch), NULL, ret) THEN
  470.     b    := CAST(BPtr,MAKEADR(ret));
  471.     void := Mshrink(b, VAL(SIGNEDLONG,Stacksize), err);
  472.  
  473.     WITH b^ DO WITH BASEP^ DO
  474.       (* Das Setzen des TPA-Endes ist wichtig fuer das
  475.        * nachfolgende "Pexec()", dorthin wird naemlich der
  476.        * Stack (A7) des neuen Prozesses gesetzt !
  477.        *)
  478.       hitpa := ADDADR(b, Stacksize);
  479.       tbase := startup;
  480.       tlen  := pTlen; (* ? *)
  481.       bbase := pBbase;
  482.       blen  := pBlen;
  483.       dbase := pDbase;
  484.       dlen  := pDlen;
  485.  
  486.       (* Parameter in der unbenoetigten Basepage-Kommandozeile uebergeben *)
  487.       tProc  := func;
  488.       tArg   := arg;
  489.     END; END;
  490.     IF MiNT THEN
  491.       done := Pexec(104, NULL, b, NULL, pid);
  492.     ELSE
  493.       (* Programm hat eine neue Basepage, deshalb die alte merken *)
  494.       base  := BASEP;
  495.       BASEP := CAST(BasePtr,b);
  496.  
  497.       start := SysClock();
  498.       done  := Pexec(4, NULL, b, NULL, pid);
  499.       (* Der Speicher fuer Basepage und Environment gehoert dem
  500.        * aufrufenden Prozess; er wird deshalb nicht automatisch nach
  501.        * Beendigung des Unterprozesses freigegeben. Ein Speicherschutzproblem
  502.        * besteht dabei fuer den Unterprozess aber nicht, da dieser Zweig nur
  503.        * durchlaufen wird, wenn MiNT, und damit der Speicherschutz, nicht
  504.        * aktiv ist.
  505.        *)
  506.       void  := Mfree(b^.env, err);
  507.       void  := Mfree(b, err);
  508.  
  509.       (* Jetzt gilt wieder die alte Basepage *)
  510.       BASEP := base;
  511.  
  512.       IF done THEN
  513.         INC(CHILDTIME, SysClock() - start);
  514.         WAITVAL.term := VAL(SIGNEDWORD,pid);
  515.         (* Aus der Basepageadresse eine Prozesskennung berechnen *)
  516.         pid := VAL(SIGNEDLONG,DosPid(b));
  517.         WAITVAL.pid  := VAL(UNSIGNEDWORD,pid);
  518.       END;
  519.     END;
  520.     IF done THEN
  521.       RETURN(INT(pid)); (* Eine gueltige Prozesskennung ist immer positiv *)
  522.     ELSE
  523.       e.errno := INT(pid);
  524.       RETURN(-1);
  525.     END;
  526.   ELSE
  527.     e.errno := INT(ret);
  528.     RETURN(-1);
  529.   END;
  530. END tfork;
  531.  
  532. (*---------------------------------------------------------------------------*)
  533.  
  534. #if (defined LPRM2) || (defined SPCM2)
  535.  
  536. PROCEDURE vfork ( ): pidT;
  537. BEGIN
  538. (*
  539.   movea.l (SP)+,A6       ; alter Framepointer vom Stack retten
  540.   movea.l (SP)+,A3       ; alte Modulbasis vom Stack retten
  541.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  542. ;; SETREG(8, mintADR);
  543.   tst.b   (A0)
  544.   beq.s   tos
  545.   move.w  #$0113,-(SP)   ; Pvfork
  546.   trap    #1             ;
  547.   addq.l  #2,SP          ;
  548.   tst.w   D0
  549.   bmi.s   err
  550.   bra.s   ende
  551. tos:
  552.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  553.   nop                    ;;
  554.   movem.l A1/A3/A5-A6,(A0)
  555.   subq.l  #2,SP          ; Platz fuer Funktionswert
  556.   pea     child(PC)      ; tfork(child, saveADR);
  557.   pea     (A0)           ;
  558.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  559.   nop                    ;;
  560.   jsr     (A0)
  561.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  562.   nop                    ;;
  563.   move.w  (SP)+,D0
  564.   movem.l (A0),A1/A3/A5-A6
  565.   bmi.s   err
  566.   bra.s   ende
  567.  
  568. child:
  569.   addq.l  #4,SP          ; RTN-Adresse weg
  570.   movea.l (SP)+,A0       ; a0 := saveADR
  571.   movem.l (A0),A1/A3/A5-A6
  572.   moveq   #0,D0
  573.   bra.s   ende
  574.  
  575. err:
  576.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  577.   nop                    ;;
  578.   move.w  D0,(A0)        ; e.errno setzen
  579.   moveq   #-1,D0
  580.  
  581. ende:
  582.   move.w  D0,(SP)
  583.   movea.l A3,A4          ; alte Modulbasis setzen
  584.   jmp     (A1)
  585. *)
  586.  CODE(2C5FH,265FH,225FH);
  587.  SETREG(8, mintADR);
  588.  CODE(4A10H,670EH,3F3CH,0113H,4E41H,548FH,4A40H,6B32H,6038H);
  589.  SETREG(8, saveADR);
  590.  CODE(48D0H,6A00H,558FH,487AH,0018H,4850H);
  591.  SETREG(8, tforkADR);
  592.  CODE(4E90H);
  593.  SETREG(8, saveADR);
  594.  CODE(301FH,4CD0H,6A00H,6B0EH,6014H,588FH,205FH,4CD0H,6A00H,7000H,6008H);
  595.  SETREG(8, errnoADR);
  596.  CODE(3080H,70FFH,3E80H,284BH,4ED1H);
  597. END vfork;
  598.  
  599. #elif (defined TDIM2)
  600.  
  601. __PROCFRAME_OFF__
  602. PROCEDURE vfork ( ): pidT;
  603. BEGIN
  604. (*
  605.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  606. ;; SETREG(8, mintADR);
  607.   tst.b   (A0)
  608.   beq.s   tos
  609.   move.w  #$0113,-(SP)   ; Pvfork
  610.   trap    #1             ;
  611.   addq.l  #2,SP          ;
  612.   tst.w   D0
  613.   bmi.s   err
  614.   bra.s   ende
  615. tos:
  616.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  617.   nop                    ;;
  618.   nop                    ;;
  619.   movem.l A1/A6,(A0)
  620.   subq.l  #2,SP          ; Platz fuer Funktionswert
  621.   pea     child(PC)      ; tfork(child, saveADR);
  622.   pea     (A0)           ;
  623.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  624.   nop                    ;;
  625.   nop                    ;;
  626.   jsr     (A0)
  627.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  628.   nop                    ;;
  629.   nop                    ;;
  630.   addq.l  #8,SP
  631.   move.w  (SP)+,D0
  632.   movem.l (A0),A1/A6
  633.   bmi.s   err
  634.   bra.s   ende
  635.  
  636. child:
  637.   addq.l  #4,SP          ; RTN-Adresse weg
  638.   movea.l (SP)+,A0       ; a0 := saveADR
  639.   movem.l (A0),A1/A6
  640.   moveq   #0,D0
  641.   bra.s   ende
  642.  
  643. err:
  644.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  645.   nop                    ;;
  646.   nop                    ;;
  647.   move.w  D0,(A0)        ; e.errno setzen
  648.   moveq   #-1,D0
  649.  
  650. ende:
  651.   move.w  D0,(SP)
  652.   jmp     (A1)
  653. *)
  654.  CODE(225FH);
  655.  SETREG(8, mintADR);
  656.  CODE(4A10H,670EH,3F3CH,0113H,4E41H,548FH,4A40H,6B3AH,6042H);
  657.  SETREG(8, saveADR);
  658.  CODE(48D0H,4200H,558FH,487AH,001EH,4850H);
  659.  SETREG(8, tforkADR);
  660.  CODE(4E90H);
  661.  SETREG(8, saveADR);
  662.  CODE(508FH,301FH,4CD0H,4200H,6B0EH,6016H,588FH,205FH,4CD0H,4200H,7000H,600AH);
  663.  SETREG(8, errnoADR);
  664.  CODE(3080H,70FFH,3E80H,4ED1H);
  665. END vfork;
  666. __PROCFRAME_ON__
  667.  
  668. #elif (defined HM2)
  669.  
  670. PROCEDURE vfork ( ): pidT;
  671. BEGIN
  672. (*
  673. ; HM
  674.   move.l  (SP)+,D1       ; Modulbasis vom Stack retten
  675.   movea.l (SP)+,A6       ; Frame-Pointer vom Stack retten
  676.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  677. ;; SETREG(8, mintADR);
  678.   tst.b   (A0)
  679.   beq.s   tos
  680.   movea.l D1,A5
  681.   move.w  #$0113,-(SP)   ; Pvfork
  682.   trap    #1             ;
  683.   addq.l  #2,SP          ;
  684.   move.l  A5,D1
  685.   tst.w   D0
  686.   bmi.s   err
  687.   bra.s   ende
  688. tos:
  689.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  690.   nop                    ;;
  691.   movem.l D1-D7/A1-A6,(A0)
  692.   pea     (A0)
  693.   pea     child(PC)      ; tfork(child, saveADR);
  694.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  695.   nop                    ;;
  696.   jsr     (A0)
  697.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  698.   nop                    ;;
  699.   movem.l (A0),D1-D7/A1-A6
  700.   tst.w   D0
  701.   bmi.s   err
  702.   bra.s   ende
  703.  
  704. child:
  705.   addq.l  #4,SP          ; RTN-Adresse weg
  706.   movea.l (SP)+,A0       ; a0 := saveADR
  707.   movem.l (A0),D1-D7/A1-A6
  708.   moveq   #0,D0
  709.   bra.s   ende
  710.  
  711. err:
  712.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  713.   nop                    ;;
  714. #ifdef __LONG_WHOLE__
  715.   move.l  D0,(A0)        ; e.errno setzen
  716. #else
  717.   move.w  D0,(A0)        ; e.errno setzen
  718. #endif
  719.   moveq   #-1,D0
  720. ende
  721.   movea.l D1,A5          ; alte Modulbasis setzen
  722.   jmp     (A1)
  723. *)
  724.  
  725.  CODE(221FH,2C5FH,225FH);
  726.  SETREG(8, mintADR);
  727.  CODE(4A10H,6712H,2A41H,3F3CH,0113H,4E41H,548FH,220DH,4A40H,6B30H,6036H);
  728.  SETREG(8, saveADR);
  729.  CODE(48D0H,7EFEH,4850H,487AH,0016H);
  730.  SETREG(8, tforkADR);
  731.  CODE(4E90H);
  732.  SETREG(8, saveADR);
  733.  CODE(4CD0H,7EFEH,4A40H,6B0EH,6014H,588FH,205FH,4CD0H,7EFEH,7000H,6008H);
  734.  SETREG(8, errnoADR);
  735. #ifdef __LONG_WHOLE__
  736.  CODE(2080H);
  737. #else
  738.  CODE(3080H);
  739. #endif
  740.  CODE(70FFH,2A41H,4ED1H);
  741. END vfork;
  742.  
  743. #elif (defined MM2)
  744.  
  745. #warning *** vfork does not work with MM2
  746.  
  747. __PROCFRAME_OFF__
  748. PROCEDURE vfork ( ): pidT;
  749. BEGIN
  750.  ASSEMBLER
  751.    MOVEA.L (A7)+, A1
  752.    TST.W   MiNT
  753.    BEQ.S   tos
  754.    MOVE.W  #$0113, -(A7)
  755.    TRAP    #1
  756.    ADDQ.L  #2, A7
  757.    TST.W   D0
  758.    BMI.S   err
  759.    BRA.S   ende
  760.  
  761.  tos:
  762.    MOVEM.L D3-D7/A1/A3-A6, regsave
  763.    LEA     child(PC), A0
  764.    MOVE.L  A0, (A3)+
  765.    MOVE.L  #regsave, (A3)+
  766. #ifdef __RES_ON_STACK__
  767.    JSR     tfork
  768. #ifdef __LONG_WHOLE__
  769.    MOVE.L  -(A3), D0
  770. #else
  771.    MOVE.W  -(A3), D0
  772. #endif
  773. #else
  774.    JSR     tfork/
  775. #endif
  776.    TST.W   D0
  777.    BMI.S   err
  778.    BRA.S   ende
  779.  
  780.  child:
  781.    ADDQ.L  #4, A7
  782.    MOVEA.L -(A3), A0
  783.    MOVEM.L (A0), D3-D7/A1/A3-A6
  784.    MOVEQ   #0, D0
  785.    BRA.S   ende
  786.  
  787.  err:
  788. #ifdef __LONG_WHOLE__
  789.    MOVE.L  D0, e.errno
  790. #else
  791.    MOVE.W  D0, e.errno
  792. #endif
  793.    MOVEQ   #-1, D0
  794.  
  795.  ende:
  796. #ifdef __RES_ON_STACK__
  797. #ifdef __LONG_WHOLE__
  798.    MOVE.L  D0, (A3)+
  799. #else
  800.    MOVE.W  D0, (A3)+
  801. #endif
  802. #endif
  803.    JMP     (A1)
  804.  END;
  805. END vfork;
  806. __PROCFRAME_ON__
  807. #endif
  808.  
  809. (*---------------------------------------------------------------------------*)
  810.  
  811. PROCEDURE wait ((* -- /AUS *) VAR state : WaitVal ): pidT;
  812.  
  813. VAR res  : WaitCode;
  814.     done : BOOLEAN;
  815.  
  816. BEGIN
  817.  state := WaitVal{};
  818.  IF MiNT THEN
  819.    done := Pwait3(WORDSET{}, NULL, res.long);
  820.  ELSE
  821.    res          := WAITVAL;
  822.    done         := res.long >= EOKL;
  823.    WAITVAL.long := e.ECHILD;
  824.  END;
  825.  IF NOT done THEN
  826.    e.errno := INT(res.long);
  827.    RETURN(-1);
  828.  END;
  829.  state := CAST(WaitVal,MakeWaitVal(res.term));
  830.  RETURN(VAL(pidT,res.pid));
  831. END wait;
  832.  
  833. (*---------------------------------------------------------------------------*)
  834.  
  835. PROCEDURE waitpid ((* EIN/ -- *)     pid     : pidT;
  836.                    (* -- /AUS *) VAR state   : WaitVal;
  837.                    (* EIN/ -- *)     options : WaitOption ): pidT;
  838.  
  839. VAR res  : WaitCode;
  840.     done : BOOLEAN;
  841.  
  842. BEGIN
  843.  state := WaitVal{};
  844.  IF MiNT THEN
  845.    done := Pwaitpid(pid, options, NULL, res.long);
  846.  ELSE
  847.    IF (pid <> -1) AND (pid <> 0) THEN
  848.      e.errno := e.EINVAL;
  849.      RETURN(-1);
  850.    END;
  851.    res          := WAITVAL;
  852.    done         := res.long >= EOKL;
  853.    WAITVAL.long := e.ECHILD;
  854.  END;
  855.  IF NOT done THEN
  856.    e.errno := INT(res.long);
  857.    RETURN(-1);
  858.  END;
  859.  state := CAST(WaitVal,MakeWaitVal(res.term));
  860.  RETURN(VAL(pidT,res.pid));
  861. END waitpid;
  862.  
  863. (*---------------------------------------------------------------------------*)
  864.  
  865. PROCEDURE WIFEXITED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  866. BEGIN
  867.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig = WaitVal{}));
  868. END WIFEXITED;
  869.  
  870. (*---------------------------------------------------------------------------*)
  871.  
  872. PROCEDURE WEXITSTATUS ((* EIN/ -- *) state : WaitVal ): INTEGER;
  873. BEGIN
  874.  RETURN(INT(CAST(SIGNEDWORD,state * wRetcode) DIV 256));
  875. END WEXITSTATUS;
  876.  
  877. (*---------------------------------------------------------------------------*)
  878.  
  879. PROCEDURE WIFSIGNALED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  880. BEGIN
  881.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig <> WaitVal{}));
  882. END WIFSIGNALED;
  883.  
  884. (*---------------------------------------------------------------------------*)
  885.  
  886. PROCEDURE WTERMSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL;
  887. BEGIN
  888.  RETURN(VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wTermsig)));
  889. END WTERMSIG;
  890.  
  891. (*---------------------------------------------------------------------------*)
  892.  
  893. PROCEDURE WIFSTOPPED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  894. BEGIN
  895.  RETURN(state * wStopval = WSTOPPED);
  896. END WIFSTOPPED;
  897.  
  898. (*---------------------------------------------------------------------------*)
  899.  
  900. PROCEDURE WSTOPSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL;
  901. BEGIN
  902.  RETURN(VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wStopsig) DIV 256));
  903. END WSTOPSIG;
  904.  
  905. (*---------------------------------------------------------------------------*)
  906.  
  907. PROCEDURE Spawn ((* EIN/ -- *)     mode : SpawnMode;
  908.                  (* EIN/ -- *) VAR prg  : ARRAY OF CHAR;
  909.                  (* EIN/ -- *)     argv : StrArray;
  910.                  (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  911.  
  912. CONST MaxStr = 10;
  913.  
  914. VAR         envPtr     : StrPtr;
  915.     __REG__ argPtr     : StrPtr;
  916.     __REG__ cmdIdx     : StrRange;
  917.     __REG__ envIdx     : StrRange;
  918.     __REG__ i          : ArrayRange;
  919.             args       : ArrayRange;
  920.             envs       : ArrayRange;
  921.             val        : ArrayRange;
  922.             pexec      : CARDINAL;
  923.             res        : INTEGER;
  924.             lres       : SIGNEDLONG;
  925.             childStart : UNSIGNEDLONG;
  926.             null       : BOOLEAN;
  927.             done       : BOOLEAN;
  928.             str        : ARRAY [0..MaxStr] OF CHAR;
  929.             cmdLine    : CmdLine;
  930.             fd         : HandleRange;
  931.             stack      : ADDRESS;
  932.             msize      : CARDINAL;
  933.             path0      : StrPtr;
  934.  
  935. PROCEDURE argcpy (arg : StrPtr; envIdx : StrRange): StrRange;
  936. VAR __REG__ i : StrRange;
  937.     __REG__ c : CHAR;
  938. BEGIN
  939.  i := 0;
  940.  REPEAT
  941.    c := arg^[i];
  942.    envPtr^[envIdx] := c;
  943.    INC(i);
  944.    INC(envIdx);
  945.  UNTIL c = 0C;
  946.  RETURN(envIdx);
  947. END argcpy;
  948.  
  949. BEGIN
  950.  e.errno := 0;
  951.  pexec := 0;
  952.  IF MiNT THEN
  953.    IF mode = pNOWAIT THEN
  954.      pexec := 100;
  955.    ELSIF mode = pOVERLAY THEN
  956.      pexec := 200;
  957.    END;
  958.  ELSIF mode = pNOWAIT THEN
  959.    e.errno := e.EINVAL;
  960.    RETURN(-1);
  961.  END;
  962.  
  963.  IF (argv = NULL) OR (argv^[0] = NULL) THEN
  964.    e.errno := e.EFAULT;
  965.    RETURN(-1);
  966.  END;
  967.  msize := SLEN(prg) + DINCR;
  968.  memalloc(VAL(sizeT,msize), stack, path0);
  969.  UnixToDos(prg, msize - DINCR, VAL(StrRange,msize), path0, null, done);
  970.  IF NOT done THEN
  971.    memdealloc(stack);
  972.    RETURN(-1);
  973.  END;
  974.  
  975.  IF envp = NULL THEN
  976.    envp := environ;
  977.  END;
  978.  
  979.  (* Laenge des benoetigten Environments berechnen.
  980.   * Dazu gehoeren entweder das uebergebene oder das aktuelle
  981.   * Environment und die Kommandozeilenargumente einschliesslich
  982.   * dem Programmnamen.
  983.   *)
  984.  lres := 0;
  985.  i    := 0;
  986.  null := FALSE;
  987.  WHILE argv^[i] <> NULL DO
  988.    res := INT(strlen(argv^[i]));
  989.    IF res = 0 THEN
  990.      null := TRUE;
  991.      (* Bei einem leeren Argument muss der Platz fuer den Index
  992.       * in der ARGV-Variable beruecksichtigt werden.
  993.       *)
  994.      IF i > 1000 THEN
  995.        res := 7; (* vier Ziffern & Komma Index + Leerzeichen + Nullbyte *)
  996.      ELSIF i > 100 THEN
  997.        res := 6;
  998.      ELSIF i > 10 THEN
  999.        res := 5;
  1000.      ELSE
  1001.        res := 4;
  1002.      END;
  1003.    ELSE
  1004.      INC(res); (* wegen Nullbyte *)
  1005.    END;
  1006.    INC(i);
  1007.    INC(lres, VAL(SIGNEDLONG,res));
  1008.  END;
  1009.  args := i;
  1010.  
  1011.  i := 0;
  1012.  WHILE envp^[i] <> NULL DO
  1013.    INC(lres, VAL(SIGNEDLONG,strlen(envp^[i]))+VAL(SIGNEDLONG,1));
  1014.    INC(i);
  1015.  END;
  1016.  envs := i;
  1017.  INC(lres, 20); (* Platz fuer "ARGV=NULL:" & sicherheitshalber etwas mehr *)
  1018.  
  1019.  (* Benoetigten Speicher anfordern.
  1020.   * Wenn nicht genuegend Speicher vorhanden ist, mit Fehlermeldung abbrechen.
  1021.   *)
  1022.  IF NOT Malloc(lres, envPtr) THEN
  1023.    e.errno := e.E2BIG;
  1024.    memdealloc(stack);
  1025.    RETURN(-1);
  1026.  END;
  1027.  envIdx := 0;
  1028.  
  1029.  (* Das Environment mit den Variablen auffuellen *)
  1030.  i := 0;
  1031.  WHILE i < envs DO
  1032.    envIdx := argcpy(envp^[i], envIdx);
  1033.    INC(i);
  1034.  END;
  1035.  
  1036.  (* Kommandozeile mit ARGV-Verfahren ins Environment schreiben.
  1037.   * Beginn der eigentlichen Argumente (nach dem Programmnamen) merken,
  1038.   * fuer die Uebertragung in die Basepage-Kommandozeile.
  1039.   *)
  1040.  IF null THEN
  1041.    str := "ARGV=NULL:";
  1042.  ELSE
  1043.    str := "ARGV=";
  1044.  END;
  1045.  envIdx := argcpy(CAST(StrPtr,ADR(str)), envIdx);
  1046.  IF null THEN
  1047.    DEC(envIdx);
  1048.    str[MaxStr] := 0C;
  1049.    i := 0;
  1050.    WHILE i < args DO
  1051.      IF argv^[i]^[0] = 0C THEN
  1052.        cmdIdx := MaxStr - 1;
  1053.        val    := i;
  1054.        REPEAT
  1055.          str[cmdIdx] := todigit(VAL(CARDINAL,val MOD 10));
  1056.          val         := val DIV 10;
  1057.          DEC(cmdIdx);
  1058.        UNTIL val = 0;
  1059.        envIdx := argcpy(CAST(StrPtr,ADR(str[cmdIdx+1])), envIdx);
  1060.        envPtr^[envIdx-1] := ',';
  1061.      END;
  1062.      INC(i);
  1063.    END;
  1064.    (* das letzte Komma ist zuviel *)
  1065.    envPtr^[envIdx-1] := 0C;
  1066.  END;
  1067.  
  1068.  str := " ";
  1069.  i   := 0;
  1070.  WHILE i < args DO
  1071.    IF argv^[i]^[0] = 0C THEN
  1072.      envIdx := argcpy(CAST(StrPtr,ADR(str)), envIdx);
  1073.    ELSE
  1074.      envIdx := argcpy(argv^[i], envIdx);
  1075.    END;
  1076.    INC(i);
  1077.  END;
  1078.  envPtr^[envIdx]   := 0C; (* Ende des Environments kennzeichnen *)
  1079.  envPtr^[envIdx+1] := 0C; (* Falls es keine Argumente gab *)
  1080.  
  1081.  (* Soviel der Argumente wie moeglich in die Basepage-Kommandozeile
  1082.   * uebertragen. ARGV-Verfahren durch den sonst ungueltigen
  1083.   * Kommandozeilenlaengenwert 127 signalisieren.
  1084.   *)
  1085.  cmdLine[0] := CHR(127);
  1086.  i      := 1;
  1087.  cmdIdx := 1;
  1088.  WHILE (i < args) AND (cmdIdx <= 124) DO
  1089.    envIdx := 0;
  1090.    argPtr := argv^[i]; INC(i);
  1091.    IF argPtr^[0] = 0C THEN
  1092.      (* Leeres Argument *)
  1093.      cmdLine[cmdIdx]   := "'";
  1094.      cmdLine[cmdIdx+1] := "'";
  1095.      INC(cmdIdx, 2);
  1096.    ELSE
  1097.      (* Argument kopieren *)
  1098.      REPEAT
  1099.        cmdLine[cmdIdx] := argPtr^[envIdx];
  1100.        INC(envIdx);
  1101.        INC(cmdIdx);
  1102.      UNTIL (argPtr^[envIdx] = 0C) OR (cmdIdx > 124);
  1103.    END;
  1104.  
  1105.    (* cmdIdx <= 126 ist gesichert *)
  1106.    IF i < args THEN
  1107.      (* Ende des Arguments erreicht *)
  1108.      cmdLine[cmdIdx] := ' ';
  1109.      INC(cmdIdx);
  1110.    ELSE
  1111.      (* Ende der Argumentliste erreicht *)
  1112.      cmdLine[cmdIdx] := 0C;
  1113.    END;
  1114.  END;
  1115.  
  1116.  (* Die restliche Kommandozeile wird geloescht. *)
  1117.  IF cmdIdx > 125 THEN
  1118.    cmdIdx := 125;
  1119.  END;
  1120.  WHILE cmdIdx < 128 DO
  1121.    cmdLine[cmdIdx] := 0C;
  1122.    INC(cmdIdx);
  1123.  END;
  1124.  
  1125.  (* Unter TOS alle offenen Dateien schliessen, bei denen das 'FdCloExec'-Flag
  1126.   * gesetzt ist. Kein WITH verwenden, da sonst evtl. keine Registervariable
  1127.   * fuer Pointer mehr uebrig.
  1128.   *)
  1129.  IF NOT MiNT THEN
  1130.    FOR fd := MinHandle TO MaxHandle DO
  1131.      IF FD[fd].cloex THEN
  1132.        done := Fclose(INT(fd), res);
  1133.        FD[fd].ftype := unknown;
  1134.        FD[fd].cloex := FALSE;
  1135.      END;
  1136.    END;
  1137.  END;
  1138.  
  1139.  childStart := SysClock();
  1140.  done := Pexec(pexec, path0, ADR(cmdLine), envPtr, lres);
  1141.  INC(CHILDTIME, SysClock() - childStart);
  1142.  
  1143.  memdealloc(stack);
  1144.  null := Mfree(envPtr, res);
  1145.  res  := INT(lres);
  1146.  IF NOT done THEN
  1147.    (* Wenn "Pexec" selbst fehlschlaegt, gibts einen
  1148.     * negativen 32-Bit-Wert.
  1149.     *)
  1150.    e.errno := res;
  1151.    RETURN(-1);
  1152.  ELSIF mode = pOVERLAY THEN
  1153.    (* Ohne MiNT muss selbst fuer die Beendigung des laufenden
  1154.     * Prozesses gesorgt werden. Mit MiNT kehrt der ``Pexec''-Aufruf
  1155.     * erst gar nicht zurueck!
  1156.     *)
  1157.    Pterm(res);
  1158.  ELSIF mode = pWAIT THEN
  1159.    RETURN(INT(MakeWaitVal(VAL(SIGNEDWORD,res))));
  1160.  ELSE
  1161.    (* Bei pNOWAIT wird die (positive) Prozess-ID zurueckgegeben *)
  1162.    RETURN(res);
  1163.  END;
  1164. END Spawn;
  1165.  
  1166. (*---------------------------------------------------------------------------*)
  1167.  
  1168. PROCEDURE spawnv ((* EIN/ -- *)     mode : SpawnMode;
  1169.                   (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1170.                   (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  1171. BEGIN
  1172.  RETURN(Spawn(mode, prg, argv, environ));
  1173. END spawnv;
  1174.  
  1175. (*---------------------------------------------------------------------------*)
  1176.  
  1177. PROCEDURE spawnve ((* EIN/ -- *)     mode : SpawnMode;
  1178.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1179.                    (* EIN/ -- *)     argv : StrArray;
  1180.                    (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  1181. BEGIN
  1182.  RETURN(Spawn(mode, prg, argv, envp));
  1183. END spawnve;
  1184.  
  1185. (*---------------------------------------------------------------------------*)
  1186.  
  1187. PROCEDURE FindExec ((* EIN/ -- *)     file : ARRAY OF CHAR;
  1188.                     (* -- /AUS *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  1189. (* BUG: Es werden maximal PATHMAX Zeichen aus "PATH" uebernommen. *)
  1190. CONST
  1191.   DEFAULTPATH = ".";
  1192. #if no_MIN_MAX
  1193.   MAXCARD = CAST(CARDINAL,-1);
  1194. #else
  1195.   MAXCARD = MAX(CARDINAL);
  1196. #endif
  1197.  
  1198. VAR  __REG__ sIdx      : INTEGER;
  1199.      __REG__ dIdx      : INTEGER;
  1200.              dtIdx     : CARDINAL;
  1201.              stIdx     : CARDINAL;
  1202.              fLen      : CARDINAL;
  1203.      __REG__ pLen      : UNSIGNEDWORD;
  1204.              l11, l12  : CARDINAL;
  1205.              l21, l22  : CARDINAL;
  1206.              st        : StatRec;
  1207.              ext       : ARRAY [0..3] OF CHAR;
  1208.              suffices  : PathName;
  1209.              dirs      : PathName;
  1210.  
  1211. BEGIN
  1212.  sIdx := RPOSCHR(0, SUFFIXSEP, file);
  1213.  dIdx := RPOSCHRSET(0, "\/", file);
  1214.  
  1215.  IF dIdx >= 0 THEN
  1216.    (* <file> enthaelt einen Pfad -> nur dort suchen.
  1217.     * Der Pfad wird aus <file> entfernt.
  1218.     *)
  1219.    COPY(0, dIdx, file, dirs);
  1220.    COPY(dIdx+1, MAXCARD, file, file);
  1221.  ELSIF NOT GetEnvVar("PATH", dirs) THEN
  1222.    (* <file> hat keinen Pfad und "PATH" existiert nicht.
  1223.     * -> nur in 'DEFAULTPATH' suchen.
  1224.     *)
  1225.    dirs := DEFAULTPATH;
  1226.  END;
  1227.  
  1228.  IF sIdx > dIdx THEN
  1229.    (* <file> hat eine Extension -> nur diese probieren.
  1230.     * Die Extension wird aus <file> entfernt.
  1231.     *)
  1232.    COPY(sIdx+1, MAXCARD, file, suffices);
  1233.    COPY(0, sIdx, file, file);
  1234.  ELSIF NOT GetEnvVar("SUFFIX", suffices) THEN
  1235.    (* <file> hat keine Extension und "SUFFIX" existiert nicht.
  1236.     * -> Extensionen aus 'EXECSUFFIX' probieren.
  1237.     *)
  1238.    ASSIGN(EXECSUFFIX, suffices);
  1239.  END;
  1240.  
  1241.  (* Jetzt enthaelt 'dirs' alle zu durchsuchenden Verzeichnisse,
  1242.   * 'suffices' alle auszuprobierenden Extensionen und 'file'
  1243.   * den ``nackten'' Dateinamen ohne Pfad und Extension.
  1244.   *)
  1245.  
  1246.  dtIdx := 0; l11 := 0;
  1247.  
  1248.  (* Jedes Verzeichnis mit allen Extensionen durchprobieren *)
  1249.  WHILE TOKEN(dirs, ";,", dtIdx, l11, l12, path) DO
  1250.    pLen := VAL(UNSIGNEDWORD,SLEN(path));
  1251.    IF     (pLen > 0) AND (pLen < PATHMAX-1)
  1252.       AND (path[pLen-1] <> DDIRSEP) AND (path[pLen-1] <> XDIRSEP)
  1253.    THEN
  1254.      path[pLen] := DDIRSEP;
  1255.      INC(pLen);
  1256.      path[pLen] := EOS;
  1257.    END;
  1258.    APPEND(file, path);
  1259.    APPENDCHR(".", path);
  1260.    (* 'path': Pfad + Dateiname + Punkt fuer Extension*)
  1261.    pLen := VAL(UNSIGNEDWORD,SLEN(path));
  1262.  
  1263.    stIdx := 0; l21 := 0;
  1264.    WHILE TOKEN(suffices, ";,", stIdx, l21, l22, ext) DO
  1265.      (* Jetzt wird probiert, ob eine Datei mit einer der angegebenen
  1266.       * Extensionen im Verzeichnis existiert. Das 'x-Bit' wird nicht
  1267.       * beruecksichtigt.
  1268.       *)
  1269.      IF ext[0] = EOS THEN
  1270.        (* Auch ohne Extension versuchen *)
  1271.        path[pLen-1] := EOS; (* Ohne Punkt *)
  1272.      ELSE
  1273.        APPEND(ext, path);   (* Extension anhaengen *)
  1274.      END;
  1275.      IF (stat(path, st) = 0) AND (st.stMode * sIFMT = sIFREG) THEN
  1276.        RETURN(TRUE);
  1277.      END;
  1278.      path[pLen-1] := '.';   (* Punkt fuer Extension wieder an seinen Platz *)
  1279.      path[pLen]   := EOS;   (* Extension wieder entfernen *)
  1280.    END;
  1281.  END;
  1282.  RETURN(FALSE);
  1283. END FindExec;
  1284.  
  1285. (*---------------------------------------------------------------------------*)
  1286.  
  1287. PROCEDURE spawnvp ((* EIN/ -- *)     mode : SpawnMode;
  1288.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1289.                    (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  1290.  
  1291. VAR path0 : PathName;
  1292.  
  1293. BEGIN
  1294.  IF FindExec(prg, path0) THEN
  1295.    RETURN(Spawn(mode, path0, argv, environ));
  1296.  ELSE
  1297.    e.errno := e.ENOENT;
  1298.    RETURN(-1);
  1299.  END;
  1300. END spawnvp;
  1301.  
  1302. (*---------------------------------------------------------------------------*)
  1303.  
  1304. PROCEDURE execve ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1305.                   (* EIN/ -- *)     argv : StrArray;
  1306.                   (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  1307. BEGIN
  1308.  RETURN(Spawn(pOVERLAY, prg, argv, envp));
  1309. END execve;
  1310.  
  1311. (*---------------------------------------------------------------------------*)
  1312.  
  1313. PROCEDURE execv ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1314.                  (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  1315. BEGIN
  1316.  RETURN(Spawn(pOVERLAY, prg, argv, environ));
  1317. END execv;
  1318.  
  1319. (*---------------------------------------------------------------------------*)
  1320.  
  1321. PROCEDURE execvp ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1322.                   (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  1323.  
  1324. VAR path0 : PathName;
  1325.  
  1326. BEGIN
  1327.  IF FindExec(prg, path0) THEN
  1328.    RETURN(Spawn(pOVERLAY, path0, argv, environ));
  1329.  ELSE
  1330.    e.errno := e.ENOENT;
  1331.    RETURN(-1);
  1332.  END;
  1333. END execvp;
  1334.  
  1335. (*---------------------------------------------------------------------------*)
  1336.  
  1337. PROCEDURE Exit ((* EIN/ -- *) retval : INTEGER );
  1338. BEGIN
  1339.  Pterm(retval);
  1340. END Exit;
  1341.  
  1342. (*---------------------------------------------------------------------------*)
  1343.  
  1344. PROCEDURE times ((* -- /AUS *) VAR buf : TmsRec ): clockT;
  1345.  
  1346. VAR clock : UNSIGNEDLONG;
  1347.     usage : ARRAY [0..7] OF UNSIGNEDLONG;
  1348.  
  1349. BEGIN
  1350.  clock := SysClock();
  1351.  IF MiNT THEN
  1352.    Prusage(ADR(usage));
  1353.    WITH buf DO
  1354.      tmsUtime  := usage[1] DIV LC(5);
  1355.      tmsStime  := usage[0] DIV LC(5);
  1356.      tmsCUtime := usage[3] DIV LC(5);
  1357.      tmsCStime := usage[2] DIV LC(5);
  1358.    END;
  1359.  ELSE
  1360.    WITH buf DO
  1361.      tmsUtime  := VAL(clockT,clock - CHILDTIME);
  1362.      tmsStime  := 0; (* nicht feststellbar *)
  1363.      tmsCUtime := VAL(clockT,CHILDTIME);
  1364.      tmsCStime := 0; (* nicht feststellbar *)
  1365.    END;
  1366.  END;
  1367.  RETURN(VAL(clockT,clock));
  1368. END times;
  1369.  
  1370. (*===========================================================================*)
  1371.  
  1372. BEGIN
  1373.  MiNT         := MiNTVersion() > 0;
  1374.  CHILDTIME    := 0;
  1375.  WAITVAL.long := e.ECHILD;
  1376.  Stacksize    := BPSIZE + MINSTACKSIZE;
  1377.  errnoADR     := ADR(e.errno);
  1378.  mintADR      := ADR(MiNT);
  1379.  saveADR      := ADR(regsave);
  1380. #if (defined LPRM2) || (defined SPCM2)
  1381.  tforkADR     := ADR(tfork);
  1382. #else
  1383.  tforkADR     := CAST(ADDRESS,tfork);
  1384. #endif
  1385. END proc.
  1386.